home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / rmail / rmail-lucid.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  7.9 KB  |  219 lines
  1. ;; Mouse and font support for RMAIL running in Lucid GNU Emacs
  2. ;; written by Wilson H. Tien (wtien@urbana.mcd.mot.com); modified by jwz.
  3. ;; Copyright (C) 1992-1993 Free Software Foundation, Inc.
  4.  
  5. ;; This file is part of XEmacs.
  6.  
  7. ;; XEmacs is free software; you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; XEmacs is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. ;; General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  19. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;;; Right button pops up a menu of commands in Rmail and Rmail summary buffers.
  22. ;;; Middle button selects indicated mail message in Rmail summary buffer
  23.  
  24. (defvar rmail-summary-mode-menu
  25.   '("Rmail Summary Commands"
  26.     ["Select Message" rmail-summary-goto-msg t nil]
  27.     "----"
  28.     ["Previous Page" scroll-down t]
  29.     ["Next Page" scroll-up t]
  30.     "----"
  31.     ["Delete Message" rmail-summary-delete-forward t nil]
  32.     ["Undelete Message" rmail-summary-undelete t nil]
  33.     "----"
  34.     ["Exit rmail Summary" rmail-summary-exit t]
  35.     ["Quit rmail" rmail-summary-quit t]))
  36.  
  37. (defun rmail-summary-update-menubar ()
  38.   ;; if min point is in visible in the window, don't make page-up menu item
  39.   ;; selectable
  40.   (let ((current-menubar rmail-summary-mode-menu)
  41.     (select '("Select Message"))
  42.     (delete '("Delete Message"))
  43.     (undelete '("Undelete Message"))
  44.     (prev-page '("Previous Page"))
  45.     (next-page '("Next Page")))
  46.     (beginning-of-line)
  47.     (let ((curmsg (string-to-int
  48.          (buffer-substring (point)
  49.                    (min (point-max) (+ 5 (point))))))
  50.       deleted-p)
  51.       (if (= 0 curmsg)
  52.       (progn
  53.         (rmail-update-menu-item delete nil)
  54.         (rmail-update-menu-item undelete nil)
  55.         (rmail-update-menu-item select nil))
  56.     (pop-to-buffer rmail-buffer)
  57.     (setq deleted-p (rmail-message-deleted-p curmsg))
  58.     (pop-to-buffer rmail-summary-buffer)
  59.     (let ((delete-menu-item 
  60.            (car (find-menu-item current-menubar delete)))
  61.           (undelete-menu-item 
  62.            (car (find-menu-item current-menubar undelete)))
  63.           (select-menu-item 
  64.            (car (find-menu-item current-menubar select)))
  65.           (msg (format "#%d" curmsg)))
  66.       (aset delete-menu-item 2 (not deleted-p))
  67.       (aset delete-menu-item 3 msg)
  68.       (aset undelete-menu-item 2 deleted-p)
  69.       (aset undelete-menu-item 3 msg)
  70.       (aset select-menu-item 2 t)
  71.       (aset select-menu-item 3 msg))))
  72.     (rmail-update-menu-item prev-page (> (window-start) (point-min)))
  73.     (rmail-update-menu-item next-page (< (window-end) (point-max)))))
  74.   
  75. (defun rmail-summary-mode-menu (event)
  76.   "Pops up a menu of applicable rmail summary commands."
  77.   (interactive "e")
  78.   (mouse-set-point event)
  79.   (beginning-of-line)
  80.   (rmail-summary-update-menubar)
  81.   (popup-menu rmail-summary-mode-menu))
  82.  
  83. ;; The following are for rmail mode 
  84. (defconst rmail-mode-menu
  85.   '("Rmail Commands"
  86.     ["Previous Page" scroll-down t]
  87.     ["Next Page" scroll-up t]
  88.     ["Top Of This Message" rmail-beginning-of-message t]
  89.     "----"
  90.     "Go To Message:"
  91.     "----"
  92.     ["Next Nondeleted Message" rmail-next-undeleted-message t]
  93.     ["Previous Nondeleted Message" rmail-previous-undeleted-message t]
  94.     ["Next Message" rmail-next-message t]
  95.     ["Previous Message" rmail-previous-message t]
  96.     ["First Message" rmail-show-message t]
  97.     ["Last Message" rmail-last-message t]
  98.     "----"
  99.     ["Delete This Message" rmail-delete-forward t]
  100.     ["Undelete This Message" rmail-undelete-previous-message t]
  101.     ["Save This Message" rmail-output-to-rmail-file t]
  102.     "----"
  103.     ["Reply This Message" rmail-reply t]
  104.     ["Forward This Message" rmail-forward t]
  105. ;    ["Continue This Message" rmail-continue t]
  106.     "----"
  107.     ["Add Label" rmail-add-label t]
  108.     ["Kill Label" rmail-kill-label t]
  109.     ["Next Labeled Message" rmail-next-labeled-message t]
  110.     ["Previous Labeled Message" rmail-previous-labeled-message t]
  111.     ["Summary by Label" rmail-summary-by-labels t]
  112.     "----"
  113.     ["Summary" rmail-summary t]
  114.     ["Get New Mail" rmail-get-new-mail t]
  115.     ["rmail Input From" rmail-input t]
  116.     ["Expunge rmail" rmail-expunge t]
  117.     ["Expunge and Save" rmail-expunge-and-save t]
  118.     ["Quit rmail" rmail-quit t]))
  119.  
  120. (defun rmail-update-menu-item (item p)
  121.   "If P is true, enable the menu item. O/w disable it."
  122.   (aset (car (or (find-menu-item current-menubar item)
  123.          (error "couldn't find rmail menu item %S" item)))
  124.     2 p))
  125.  
  126. (defun rmail-update-menubar ()
  127.   (let ((current-menubar rmail-mode-menu)
  128.     (prev-page '("Previous Page"))
  129.     (next-page '("Next Page"))
  130.     (top-page '("Top Of This Message"))
  131.     (real-next '("Next Message"))
  132.     (real-prev '("Previous Message"))
  133.     (undel-next '("Next Nondeleted Message"))
  134.     (undel-prev '("Previous Nondeleted Message"))
  135.     (delete '("Delete This Message"))
  136.     (undelete '("Undelete This Message"))
  137.     i)
  138.     ;; Disable/enable page-up/page-down menu items
  139.     (rmail-update-menu-item prev-page (> (window-start) (point-min)))
  140.     (rmail-update-menu-item next-page (< (window-end) (point-max)))
  141.     (rmail-update-menu-item top-page (> (window-start) (point-min)))
  142.     (rmail-update-menu-item real-next
  143.               (/= rmail-current-message rmail-total-messages))
  144.     (rmail-update-menu-item real-prev (/= rmail-current-message 1))
  145.     (setq i (1+ rmail-current-message))
  146.     (while (and (<= i rmail-total-messages) (rmail-message-deleted-p i))
  147.       (setq i (1+ i)))
  148.     (rmail-update-menu-item undel-next (<= i rmail-total-messages))
  149.     (setq i (1- rmail-current-message))
  150.     (while (and (>= i 1) (rmail-message-deleted-p i))
  151.       (setq i (1- i)))
  152.     (rmail-update-menu-item undel-prev (>= i 1))
  153.     (rmail-update-menu-item delete 
  154.               (not (rmail-message-deleted-p rmail-current-message)))
  155.     (rmail-update-menu-item undelete 
  156.               (rmail-message-deleted-p rmail-current-message))
  157.     t))
  158.   
  159. (defun rmail-mode-menu (event)
  160.   "Pops up a menu of applicable rmail commands."
  161.   (interactive "e")
  162.   (select-window (event-window event))
  163.   (rmail-update-menubar)
  164.   (popup-menu rmail-mode-menu))
  165.  
  166. (defun rmail-activate-menubar-hook ()
  167.   (cond ((eq major-mode 'rmail-mode)
  168.      (rmail-update-menubar))
  169.     ((eq major-mode 'rmail-summary-mode)
  170.      (rmail-summary-update-menubar))))
  171.  
  172. (add-hook 'activate-menubar-hook 'rmail-activate-menubar-hook)
  173.  
  174. ;;; Put message headers in boldface, etc...
  175.  
  176. (require 'highlight-headers)
  177.  
  178. (defun rmail-fontify-headers ()
  179.   (highlight-headers (point-min) (point-max) t))
  180.  
  181. (add-hook 'rmail-show-message-hook 'rmail-fontify-headers)
  182.  
  183. ;; MENU and MENUBAR setup for both Rmail and Rmail summary buffers
  184. (defun rmail-install-menubar ()
  185.   (if (and current-menubar (not (assoc (car rmail-mode-menu) current-menubar)))
  186.       (let ((menu (cond ((eq major-mode 'rmail-mode) rmail-mode-menu)
  187.             ((eq major-mode 'rmail-summary-mode)
  188.              rmail-summary-mode-menu)
  189.             (t (error "not rmail or rmail summary mode")))))
  190.     (set-buffer-menubar (copy-sequence current-menubar))
  191.     (add-menu nil (car rmail-mode-menu) (cdr menu)))))
  192.  
  193. (defun rmail-mode-menu-setup ()
  194.   (rmail-install-menubar)
  195.   (define-key rmail-mode-map 'button3 'rmail-mode-menu))
  196.  
  197. (add-hook 'rmail-mode-hook 'rmail-mode-menu-setup)
  198.  
  199. (defun rmail-summary-mode-menu-setup ()
  200.   (rmail-install-menubar)
  201.   (define-key rmail-summary-mode-map 'button2 'rmail-summary-mouse-goto-msg)
  202.   (define-key rmail-summary-mode-map 'button3 'rmail-summary-mode-menu))
  203.  
  204. (defun rmail-summary-mouse-goto-msg (e)
  205.   (interactive "e")
  206.   (mouse-set-point e)
  207.   (beginning-of-line)
  208.   (rmail-summary-goto-msg))
  209.  
  210. (defun rmail-install-mouse-tracker ()
  211.   (require 'mode-motion)
  212.   (setq mode-motion-hook 'mode-motion-highlight-line))
  213.  
  214. (add-hook 'rmail-summary-mode-hook 'rmail-install-mouse-tracker)
  215. (add-hook 'rmail-summary-mode-hook 'rmail-summary-mode-menu-setup)
  216.  
  217.  
  218. (provide 'rmail-lucid)
  219.